Garbo/Garbo.cdr/mac/hypercrd/xcmd/dxcmds34.sit/Dartmouth XCMD's 3.4.3/stack.txt

Text File | 1990-04-17 | 12KB | 384 lines

-- stack: in.3
-- format: 8 (HyperCard 1)
-- flags: 0xD000 (can't modify, can't delete)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 7
-- first background id: 2749
-- card count: 48
-- first card id: 9912
-- list block id: 21972
-- print block id: 0
-- font table block id: 0
-- style table block id: 0
-- free block count: 0
-- free size: 0 bytes
-- total size: 531360 bytes
-- stack block size: 10752 bytes
-- created by hypercard version: 0x00000000
-- compacted by hypercard version: 0x01258000
-- modified by hypercard version: 0x01258000
-- opened by hypercard version: 0x01258000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x8000000008000000
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x8888222288882222
-- patterns[4]: 0x88AA22AA88AA22AA
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
on openCard
  set the cursor to watch
  UpdateXCMDMenu
  set the cursor to hand
end opencard

on openStack
  if the short name of this card is "start" then DoPicture
  AddMenu
end openstack

on closestack
  RemoveMenu
end closestack

on DoPicture
  -- this handler requires XCMD PictureShow and XFCN IsResource
  global iSawThePicture
  if (iSawThePicture is empty) and IsResource("PICT","Dartmouth Arms") then
    show card field "obscure buttons"
    put the visible of msg into msgVis
    hide msg
    lock screen
    PictureShow "Dartmouth Arms",165,82,1,"onPress"
    set the visible of msg to msgVis
    put "Indeed" into iSawThePicture
    hide card field "obscure buttons"
    unlock screen with dissolve
  else hide card field "obscure buttons"
end DoPicture

on AddMenu
  -- this handler requires XCMD MenuHandler
  global XCMDsMenu
  put "Index…,Search…,(-,Install…,(-,(Print Documentation…," into itemList
  put "(Print Source…,(-,(Save Source in File…" after itemList
  put itemList into XCMDsMenu
  MenuHandler "Add","XCMD's",itemList
end AddMenu

on RemoveMenu
  -- this handler requires XCMD MenuHandler
  MenuHandler "Delete","XCMD's"
end RemoveMenu

on domenu anItem
  global XCMDsMenu
  if XCMDsMenu contains anItem then
    DoXCMDs anItem -- see which item it is and do something
  else   -- is an enable HyperCard item
    pass domenu -- pass it on down the line
    exit domenu
  end if
end domenu

on DoXCMDs anItem
  if anItem is "Index…" then
    DoIndex
  else if anItem is "Search…" then
    DoSearch
  else if anItem is "Install…" then
    send "Install" to this card
  else if anItem is "Print Documentation…" then
    DoPrintDoc
  else if anItem is "Print Source…" then
    DoPrintSource
  else if anItem is "Save Source in File…" then
    DoSourceToFile
  end if
end DoXCMDs

on DoIndex
  -- this handler requires XFCN XScrollBox
  global gLastIndexChoice
  put SortField(card field "index" of card 1) into list
  if gLastIndexChoice is empty then
    put 1 into gLastIndexChoice
  end if
  get XScrollBox(gLastIndexChoice,"Choose an XCMD:",list)
  go to this card -- update the window
  if it is not empty then
    set the cursor to watch
    put item 1 of it into gLastIndexChoice
    go card item 2 of it
    set the cursor to hand
  end if
  choose browse tool
end DoIndex

on DoSearch
  -- this handler requires the following resources:
  -- DLOG "Find",DITL "Find",XFCN "ModalDialog"
  global findMode,whatToFind
  put whatToFind into line 4 of dialogInput
  if findMode is "whole" then
    put "ON" into line 5 of dialogInput
  else if findMode is "string" then
    put "ON" into line 6 of dialogInput
  else put "ON" into line 7 of dialogInput
  put ModalDialog("find",dialogInput,cardCenter) into dialogOutput
  if dialogOutput is "Cancel" then exit DoSearch
  put line 4 of dialogOutput into whatToFind
  if line 5 of dialogOutput is "ON" then
    put "whole" into findMode
  else if line 6 of dialogOutput is "ON" then
    put "string" into findMode
  else put empty into findMode
  put "find" && findMode && quote & whatToFind & quote into command
  do command
end DoSearch

on DoPrintDoc
  -- this handler requires XCMD PrintField and XFCN ObjectExists
  if ObjectExists("card field Documentation") then
    PrintField "card field Documentation",1
  else if ObjectExists("field Documentation") then
    PrintField "field Documentation",1,36,36,36,36
  end if
end DoPrintDoc

on DoPrintSource
  -- this handler requires XCMD PrintField and XFCN ObjectExists
  if ObjectExists("card field source") then
    PrintField "card field source",1,36,36,36,36
  end if
  if ObjectExists("card field source1") then
    PrintField "card field source1",1,36,36,36,36
    if the result is "Cancel" then exit DoPrintSource
  end if
  if ObjectExists("card field source2") then
    PrintField "card field source2",1,36,36,36,36
  end if
end DoPrintSource

on ShowError theError
  answer "Sorry, an error occurred.  (" & theError & ")"
end ShowError

on DoSourceToFile
  -- this handler requires XCMD WriteToFile and XFCN ObjectExists
  put the short name of this card into fileName
  if the short name of this background is "Roger's" then
    put ".c" after fileName
    put "KAHL" into creator
  else if the short name of this background is "Kevin's" then
    put ".p" after fileName
    put "MPS " into creator
  end if
  if ObjectExists("card field source") then
    WriteToFile card field "Source",FALSE,fileName,FALSE,creator
    put the result into theResult
    if word 1 of theResult is "Error" then ShowError
  end if
  -- the sources to MenuHandler and ModalDialog are in two parts,
  -- therefore the following:
  if ObjectExists("card field source1") and ObjectExists("card field source2") then
    WriteToFile card field "Source1",FALSE,fileName,FALSE,creator
    put the result into theResult
    if theResult is "Cancel" then exit DoSourceToFile
    if word 1 of theResult is "Error" then
      delete word 1 of theResult
      ShowError theResult
      exit DoSourceToFile
    end if
    WriteToFile card field "Source2",TRUE,theResult,TRUE
  end if
end DoSourceToFile

on UpdateXCMDMenu
  -- this handler requires XCMD MenuHandler and XFCN ObjectExists
  if ObjectExists("card field Documentation") or ObjectExists("field Documentation")
  then
  MenuHandler "Enable","XCMD's","Print Documentation…"
else
  MenuHandler "Disable","XCMD's","Print Documentation…"
end if
if ObjectExists("card field source") or ObjectExists("card field source1") or ObjectExists("card field source2")
then
MenuHandler "Enable","XCMD's","Print Source…"
MenuHandler "Enable","XCMD's","Save Source in File…"
else
  MenuHandler "Disable","XCMD's","Print Source…"
  MenuHandler "Disable","XCMD's","Save Source in File…"
end if
if Offset("Install",the script of this card) > 0 then MenuHandler "Enable","XCMD's","Install…"
else MenuHandler "Disable","XCMD's","Install…"
end UpdateXCMDMenu

function ResInStack resType,resName,resID,stackName
global resInfo
lock screen
push card
go to stack stackName
put the long name of this stack into stackPathname
delete word 1 of stackPathname
delete char 1 of stackPathname
delete last char of stackPathName
put IsResource(resType,resName,resID,TRUE) into resExists
pop card
unlock screen
if resExists is FALSE then return FALSE
else return (item 5 of resInfo is stackPathname)
end ResInStack

on InstallResource resType,resName,targetStack
  global resInfo
  set cursor to watch
  if not IsResource(resType,resName) THEN
    answer resType && quote & resName & quote && "does not exist."
    exit InstallResource
  end if
  put item 3 of resInfo into resID
  put the long name of this stack into thisStack
  delete first word of thisStack
  delete first char of thisStack
  delete last char of thisStack
  if targetStack is thisStack then exit InstallResource
  set lockMessages to TRUE
  lock screen
  push card
  go stack targetStack
  if ResInStack(resType,resName,empty,targetStack) then
    answer "Replace" && resType && quote & resName & quote & "?" with "OK" or "Cancel"
    if it is "Cancel" then
      pop card
      unlock screen
      set lockMessages to FALSE
      exit InstallResource
    end if
  end if
  if ResInStack(resType,empty,resID,targetStack) then
    if item 2 of resInfo is not resName then
      answer "Replace" && resType && resID & "?" with "OK" or "Cancel"
      if it is "Cancel" then
        pop card
        unlock screen
        set lockMessages to FALSE
        exit InstallResource
      end if
    end if
  end if
  pop card
  RInstall resType,resName,targetStack
  get the result
  if it is not empty then answer it
  unlock screen
  set lockMessages to FALSE
end InstallResource

function ChooseTargetStack
set lockMessages to TRUE
lock screen
push card
put the short name of this card into resName
if LENGTH(resName) > 14 then put "resource" into resName
go stack "target stack for" && resName
put the long name of this stack into targetStack
delete first word of targetStack
delete first char of targetStack
delete last char of targetStack
pop card
unlock screen
set lockMessages to FALSE
return targetStack
end ChooseTargetStack

on lockFields lockOrUnlock
  set lockMessages to true
  put the number of bgs into bNum
  repeat with b = 1 to bNum
    put "background"&&b
    go bg b
    put the number of fields into fNum
    repeat with f = 1 to fNum
      put the name of field f into fname
      set the lockText of fname to lockOrUnlock
    end repeat
  end repeat
  go first
  put the number of cards into cNum
  repeat with c = 1 to cNum
    put "card"&&c
    go card c
    put the number of card fields into fNum
    repeat with f = 1 to fNum
      put the id of card field f into fID
      set the locktext of card field ID fID to lockOrUnlock
    end repeat
  end repeat
  go first
  set lockMessages to false
  hide msg
end lockFields


on SetProtect lockOrUnlock
  set lockMessages to true
  put the number of bgs into bNum
  repeat with b = 1 to bNum
    put "background"&&b
    go bg b
    set cantDelete of this bg to lockOrUnlock
  end repeat
  go first
  put the number of cards into cNum
  repeat with c = 1 to cNum
    put "card"&&c
    go card c
    set cantDelete of this card to lockOrUnlock
  end repeat
  go first
  set lockMessages to false
  hide msg
end SetProtect